home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / eulisp / mpfeel.lha / MPFeel / Plurals / mp_vector.m < prev    next >
Text File  |  1992-07-20  |  12KB  |  442 lines
  1. /*
  2.  *    Plurals
  3.  *
  4.  *    Author:    S.C.Merrall
  5.  *
  6.  *    File:        mp_vector.m
  7.  *
  8.  *    Contents:    make_vector
  9.  *            vector_ref
  10.  *            vector_set
  11.  *            vector_length
  12.  *                      vector_merge
  13.  *
  14.  *    Description:    Functions for creating and accessing the contents
  15.  *            of vectors
  16.  *
  17.  *    Change History:
  18.  *
  19.  *    Date   Name Comment
  20.  *    -------- ---- -------
  21.  *    15:05:91 SCM  Created
  22.  *
  23.  */
  24.  
  25. #include <mpl.h>
  26. #include <stdio.h>
  27.  
  28. #include "constant.h"
  29.  
  30. #include "mp_object.h"
  31. #include "mp_debug.h"
  32. #include "mp_type.h"
  33. #include "mp_gc.h"
  34.  
  35. /*----------------------------------------------------------------------------*
  36.  * Function   : make_vector
  37.  *
  38.  * Parameters : MP_PluralHeap MPPH_length:    Size of vector
  39.  *        MP_PluralHeap MPPH_vector:    Resulting vectors
  40.  *
  41.  * Description: Allocate a vector of 'length' elements, each element is 
  42.  *        initially set to nil
  43.  *
  44.  * Result     : int:    SUCESS/FAIL
  45.  *---------------------------------------------------------------------------*/
  46.  
  47. #ifdef __STDC__
  48.  
  49. int make_vector( MP_PluralHeap MPPH_length, MP_PluralHeap MPPH_vector )
  50.  
  51. #else
  52.  
  53. int make_vector( MPPH_length, MPPH_vector )
  54.  
  55. MP_PluralHeap MPPH_length;
  56. MP_PluralHeap MPPH_vector;
  57.  
  58. #endif
  59.  
  60. {
  61.   plural natural *plural new_vector;
  62.   plural int length;
  63.   plural int i;
  64. DBG_CALL("make_vector");
  65. DBG_ARGS(fprintf(dbg,"length=????, MPPH_vector=%04x",MPPH_vector));
  66.  
  67.   /* Check all the lengths are integers */
  68.  
  69.   if (globalor(OA_info(MPPH_length) != INTEGER)) {
  70.  
  71. DBG_FAIL(fprintf(dbg,"FAIL: Not all the lengths are integers"));
  72.     return FAIL;
  73.   }
  74.   length = *(plural int *plural) OA_data(MPPH_length);
  75.  
  76.   /* Allocate space for new vectors */
  77.  
  78.   if (mp_alloc((plural int) MP_VECTOR, length, MPPH_vector) == FAIL) {
  79.  
  80. DBG_FAIL(fprintf(dbg,"FAIL: Unable to allocate space")); 
  81.     return FAIL;
  82.   }
  83.  
  84.   new_vector = (plural natural *plural) OA_data(MPPH_vector);
  85.  
  86.   for (i=0; i < length; i++) {            /* Initialise all elements to NIL */
  87.  
  88.     *(new_vector + i) = NIL;
  89.   }
  90.  
  91. DBG_EXIT(fprintf(dbg,"SUCCESS"));
  92.   return SUCCESS;
  93. }
  94.  
  95. /*----------------------------------------------------------------------------*
  96.  * Function   : vector_set
  97.  *
  98.  * Parameters : MP_PluralHeap MPPH_vector:    MasPar Plural Heap object, 
  99.  *                        handle on the vectors 
  100.  *        MP_PluralHeap MPPH_index:    Index of the vector which is 
  101.  *                        to be updated.
  102.  *        MP_PluralHeap MPPH_value:    MasPar Plural Heap object, 
  103.  *                        handle on Heap space of new 
  104.  *                        value at that index.
  105.  *
  106.  * Description:    Sets the indexth element of the vector MPPH_vector to
  107.  *        be MPPH_value. Note that each element of MPPH_value can be
  108.  *        a different object and that each elemnt of index can have
  109.  *        a different value. These are full parallel versions!
  110.  *
  111.  * Result     : int:    SUCCESS/FAIL
  112.  *---------------------------------------------------------------------------*/
  113.  
  114. #ifdef __STDC__
  115.  
  116. int vector_set( MP_PluralHeap MPPH_vector, MP_PluralHeap index, 
  117.         MP_PluralHeap MPPH_value )
  118.  
  119. #else
  120.  
  121. int vector_set( MPPH_vector, MPPH_index, MPPH_value )
  122.  
  123. MP_PluralHeap MPPH_vector;
  124. MP_PluralHeap MPPH_index;
  125. MP_PluralHeap MPPH_value; 
  126.  
  127. #endif
  128.  
  129. {
  130.   plural natural *plural vector;
  131.   plural int index;
  132. DBG_CALL("vector_set");
  133. DBG_ARGS(fprintf(dbg,"MPPH_vector=????, MPPH_index=????, MPPH_value=????"));
  134.  
  135.   /* Check these are all vectors */
  136.  
  137.   if (globalor(OA_info(MPPH_vector) != MP_VECTOR)) {
  138.  
  139. DBG_FAIL(fprintf(dbg,"FAIL: Not all these are vectors"));
  140.     return FAIL;
  141.   }
  142.  
  143.   /* Check index is an integer and within the range of all the vectors */
  144.  
  145.   if (globalor(OA_info(MPPH_index) != INTEGER)) {
  146.  
  147. DBG_FAIL(fprintf(dbg,"FAIL: Not all the indexes are integers"));
  148.     return FAIL;
  149.   }
  150.  
  151.   index = *(plural int *plural) OA_data(MPPH_index);
  152.  
  153.   if (globalor((MP_LENGTH(OA_space(MPPH_vector)) <= index) ||
  154.                (index < 0))) {
  155.  
  156. DBG_FAIL(fprintf(dbg,"FAIL: index is too large for some of the vectors"));
  157.     return FAIL;
  158.   }
  159.  
  160.   vector = (plural natural *plural) OA_data(MPPH_vector);
  161.   *(vector + index) = OA_offsets(MPPH_value);
  162.  
  163. DBG_EXIT(fprintf(dbg,"SUCCESS"));
  164.   return SUCCESS;
  165. }
  166.  
  167. /*----------------------------------------------------------------------------*
  168.  * Function   : vector_ref
  169.  *
  170.  * Parameters : MP_PluralHeap MPPH_vector:    MasPar Plural Heap object, 
  171.  *                        handle on the vectors 
  172.  *        MP_PluralHeap index:        Index of the vector which is 
  173.  *                        to be updated.
  174.  *        MP_PluralHeap MPPH_result:    MasPar Plural Heap object, 
  175.  *                        handle on indexth objects
  176.  *
  177.  * Description:    Refs the indexth element of the vector MPPH_vector into
  178.  *         MPPH_value. 
  179.  *
  180.  * Result     : int:    SUCCESS/FAIL
  181.  *---------------------------------------------------------------------------*/
  182.  
  183. #ifdef __STDC__
  184.  
  185. int vector_ref( MP_PluralHeap MPPH_vector, MP_PluralHeap MPPH_index, 
  186.         MP_PluralHeap MPPH_result )
  187.  
  188. #else
  189.  
  190. int vector_ref( MPPH_vector, MPPH_index, MPPH_result )
  191.  
  192. MP_PluralHeap MPPH_vector;
  193. MP_PluralHeap MPPH_index;
  194. MP_PluralHeap MPPH_result; 
  195.  
  196. #endif
  197.  
  198. {
  199.   plural natural *plural vector;
  200.   plural int index;
  201. DBG_CALL("vector_ref");
  202. DBG_ARGS(fprintf(dbg,"MPPH_vector=????, index=????, MPPH_result=????"));
  203.  
  204.   /* Check these are all vectors */
  205.  
  206.   if (globalor(OA_info(MPPH_vector) != MP_VECTOR)) {
  207.  
  208. DBG_FAIL(fprintf(dbg,"FAIL: Not all these are vectors"));
  209.     return FAIL;
  210.   }
  211.  
  212.   /* Check index is an integer and within the range of all the vectors */
  213.  
  214.   if (globalor(OA_info(MPPH_index) != INTEGER)) {
  215.  
  216. DBG_FAIL(fprintf(dbg,"FAIL: Not all the indexes are inetegers"));
  217.     return FAIL;
  218.   }
  219.  
  220.   index = *(plural int *plural) OA_data(MPPH_index);
  221.  
  222.   if (globalor((MP_LENGTH(OA_space(MPPH_vector)) <= index) ||
  223.            (index < 0))) {
  224.  
  225. DBG_FAIL(fprintf(dbg,"FAIL: index out of some of the vectors range"));
  226.     return FAIL;
  227.   }
  228.  
  229.   vector = (plural natural *plural) OA_data(MPPH_vector);
  230.   OA_offsets(MPPH_result) = *(vector + index);
  231.  
  232. DBG_EXIT(fprintf(dbg,"SUCCESS"));
  233.   return SUCCESS;
  234. }
  235.  
  236. /*----------------------------------------------------------------------------*
  237.  * Function   : vector_length
  238.  *
  239.  * Parameters : MP_PluralHeap MPPH_vector:    Handles on the vectors heap
  240.  *                        space and
  241.  *        MP_PluralHeap MPPH_result:    where the lengths are to go
  242.  *
  243.  * Description: Extracts and returns the integer length of each of the 
  244.  *        vectors
  245.  *
  246.  * Result     : int:    FAIL/SUCCESS
  247.  *---------------------------------------------------------------------------*/
  248.  
  249. #ifdef __STDC__
  250.  
  251. int vector_length( MP_PluralHeap MPPH_vector, MP_PluralHeap MPPH_result )
  252.  
  253. #else
  254.  
  255. int vector_length( MPPH_vector, MPPH_result )
  256.  
  257. MP_PluralHeap MPPH_vector;
  258. MP_PluralHeap MPPH_result;
  259.  
  260. #endif
  261.      
  262. {
  263.   plural int *plural length;
  264. DBG_CALL("vector_length");
  265. DBG_ARGS(fprintf(dbg,"MPPH_vector=????, MPPH_result=????"));
  266.  
  267.   /* Check these are all vectors */
  268.  
  269.   if (OA_info(MPPH_vector) != MP_VECTOR) {
  270.  
  271. DBG_FAIL(fprintf(dbg,"FAIL: Not all od these are vectors"));
  272.     return FAIL;
  273.   }
  274.  
  275.   /* Allocate space for the length to go in */
  276.  
  277.   if (mp_alloc((plural int) INTEGER, (plural int) 1, MPPH_result) == FAIL) {
  278.  
  279. DBG_FAIL(fprintf(dbg,"FAIL: Unable to allocate space for the lengths"));
  280.     return FAIL;
  281.   }
  282.  
  283.   length = (plural int *plural) OA_data(MPPH_result);
  284.  
  285.   *length = MP_LENGTH(OA_space(MPPH_vector));
  286.  
  287. DBG_EXIT(fprintf(dbg,"SUCCESS"));
  288.   return SUCCESS;
  289. }
  290.   
  291.  
  292.  /* Experimental hacks for new processor management mechanism which */
  293.  /* supports overloading of processors at the back end instruction  */
  294.  /* level */
  295.  
  296. /*----------------------------------------------------------------------------*
  297.  * Function   : vector_merge
  298.  *
  299.  * Parameters : MP_PluralHeap MPPH_set1:    Handles on the keys and
  300.  *        MP_PluralHeap MPPH_set21:    data vectors which are 
  301.  *        MP_PluralHeap MPPH_result:    to be merge sorted
  302.  *
  303.  * Description: This function is a bit of hack but I think is justified.
  304.  *        We merge sort the two key vectors, at the same time we do
  305.  *        identical operations on the two data vectors, this will 
  306.  *         allow us to join sets of (virtual) processors and their 
  307.  *        values efficiently.
  308.  *
  309.  * Result     : int FAIL/SUCCESS
  310.  *---------------------------------------------------------------------------*/
  311.  
  312. #ifdef __STDC__
  313.  
  314. int vector_merge( MP_PluralHeap MPPH_set1, MP_PluralHeap MPPH_set2,
  315.           MP_PluralHeap MPPH_result )
  316.  
  317. #else
  318.  
  319. int vector_merge( MPPH_set1, MPPH_set2, MPPH_result )
  320.  
  321. MP_PluralHeap MPPH_set1;
  322. MP_PluralHeap MPPH_set2;
  323. MP_PluralHeap MPPH_result;
  324.  
  325. #endif
  326.  
  327. {
  328.   plural natural *plural key1;
  329.   plural natural *plural key2;
  330.   plural natural *plural to = (plural natural *plural) scratch;
  331.   plural natural *plural from1;
  332.   plural natural *plural from2;
  333.   plural natural *plural data1, *plural data2;
  334.   plural natural *plural last1;
  335.   plural natural *plural last2;
  336.   plural int val1, val2;
  337.   int to_data_offset;
  338. DBG_CALL("vector_merge");
  339. DBG_ARGS(DBG_PARG("MPPH_set1","%x ",MPPH_set1);DBG_PARG("MPPH_set2","%x ",MPPH_set2);DBG_PARG("MPPH_result","%x ",MPPH_result));
  340.  
  341.   to_data_offset = SCRATCH_MEMORY_SIZE/(2*sizeof(natural));
  342.  
  343.   /* We are expecting a cons cell of key vector and data vector, so we */
  344.   /* take the  car (in a hackery way) to get the key. */
  345.  
  346.   key1 = (plural natural *plural) OA_data(MPPH_set1);
  347.   key2 = (plural natural *plural) OA_data(MPPH_set2);
  348.  
  349.   from1 = (plural natural *plural) OA_data(key1);
  350.   from2 = (plural natural *plural) OA_data(key2);
  351.  
  352.   last1 = from1 + MP_LENGTH(OA_space(key1));
  353.   last2 = from2 + MP_LENGTH(OA_space(key2));
  354.  
  355.   data1 = (plural natural *plural) OA_data((plural natural *plural) (OA_data(MPPH_set1) + sizeof(natural)));
  356.   data2 = (plural natural *plural) OA_data((plural natural *plural) (OA_data(MPPH_set2) + sizeof(natural)));
  357.  
  358.   while ((from1 < last1) || (from2 < last2)) {
  359.  
  360.     val1 = * (plural int *plural) OA_data( (plural natural *plural) (OA_data(from1) +2));
  361.     val2 = * (plural int *plural) OA_data( (plural natural *plural) (OA_data(from2) + 2));
  362.  
  363. /*    val1 = * (plural int *plural) OA_data(from1);
  364.     val2 = * (plural int *plural) OA_data(from2);*/
  365.  
  366. DEBUG(DBG_PARG("val1"," %d",val1));
  367. DEBUG(DBG_PARG("val2"," %d",val2));
  368.  
  369.     if (val1 == val2) {
  370.  
  371.       *to = *(from1++);
  372.       from2++;
  373.       *(to + to_data_offset) = *(data1++);
  374.       data2++;
  375.     }
  376.     else if (val1 < val2) {
  377.  
  378.       *to = *(from1++);
  379.       *(to + to_data_offset) = *(data1++);
  380.     }      
  381.     else {
  382.  
  383.       *to = *(from2++);
  384.       *(to + to_data_offset) = *(data2++);
  385.     }
  386.     to++;
  387.  
  388.     if (from1 >= last1) {
  389.  
  390.       pp_memcpy((plural char *plural) to,
  391.         (plural char *plural) from2, 
  392.         (plural char *plural) last2 - (plural char *plural) from2);
  393.       pp_memcpy((plural char *plural) (to + to_data_offset),
  394.         (plural char *plural) data2, 
  395.         (plural char *plural) last2 - (plural char *plural) from2);
  396.       to = to + (last2 - from2);
  397.       from2 = last2;
  398.     }
  399.     else if (from2 >= last2) {
  400.  
  401.       pp_memcpy((plural char *plural) to,
  402.         (plural char *plural) from1, 
  403.         ((plural char *plural) last1 - (plural char *plural) from1));
  404.       pp_memcpy((plural char *plural) (to + to_data_offset),
  405.         (plural char *plural) data1, 
  406.         ((plural char *plural) last1 - (plural char *plural) from1));
  407.       to = to + (last1 - from1);
  408.       from1 = last1;
  409.     }
  410.   }
  411.  
  412.   if (mp_alloc((plural int) MP_CONS, (plural int) 1, MPPH_result) == FAIL) {
  413.  
  414. DBG_FAIL(fprintf(dbg,"FAIL: Unable to allocate cons for merge "));    
  415.     return FAIL;
  416.   }
  417.   if (mp_alloc((plural int) MP_VECTOR, to - (plural natural *plural) scratch,
  418.            (plural natural *plural) OA_data(MPPH_result)) == FAIL) {
  419.  
  420. DBG_FAIL(fprintf(dbg,"FAIL: Unable to allocate vector for merge key"));
  421.     return FAIL;
  422.   }
  423.   if (mp_alloc((plural int) MP_VECTOR, to - (plural natural *plural) scratch,
  424.            ((plural natural *plural) OA_data(MPPH_result)) +1) == FAIL) {
  425.  
  426. DBG_FAIL(fprintf(dbg,"FAIL: Unable to allocate vector for merge data"));
  427.     return FAIL;
  428.   }
  429.  
  430.   pp_memcpy(OA_data((plural natural *plural) OA_data(MPPH_result)),
  431.         (plural natural *plural) scratch,
  432.         ((plural char *plural) to) - scratch);
  433.   pp_memcpy(OA_data((plural natural *plural) (OA_data(MPPH_result) + sizeof(natural))),
  434.         ((plural char *plural) scratch) +(to_data_offset*sizeof(natural)),
  435.        ((plural char *plural) to) - scratch);
  436.  
  437. DBG_EXIT(fprintf(dbg,"SUCCESS"));
  438.  
  439.   return SUCCESS;
  440. }
  441.  
  442.